﻿Imports HGARCPSP.myconst
Imports System.Text

Public Class clsTaskLib

    Private ProjectLength As Int32 = 0
    Private ProjectCalculated As Boolean = False

    Public Event Progress(ByVal nIt As Int32, ByVal nSum As Int32)

    Private avg As Single

#Region "Init"

    Private Function PrepareOutFolder(ByRef sFolder As String, ByVal starttime As Date) As Boolean
        Try
            Dim jq As String = "jquery-1.7.1-min.js"
            sFolder = My.Application.Info.DirectoryPath & "\OUT\"
            If Not IO.Directory.Exists(sFolder) Then IO.Directory.CreateDirectory(sFolder)
            sFolder &= starttime.ToString("yyyyMMdd_HHmmss") & "\"
            If Not IO.Directory.Exists(sFolder) Then IO.Directory.CreateDirectory(sFolder)
            If Not IO.File.Exists(sFolder & jq) Then
                IO.File.Copy(My.Application.Info.DirectoryPath & "\INPUT\" & jq, sFolder & jq)
            End If
            Return True
        Catch ex As Exception
            Throw
        End Try
    End Function

    Private Function SetPopSize(ByVal type As clsPSPLIB.eJType, ByRef name As String, ByRef pi As Single, ByVal maxSched As Int32, ByRef vars()() As Single) As Int32
        Try
            Dim popmax As Int32
            Select Case maxSched
                Case 2500
                    Select Case type
                        Case clsPSPLIB.eJType.J120
                            popmax = 23
                            name = "J120"
                            pi = 0.6
                    End Select
                Case 1000
                    Select Case type
                        Case clsPSPLIB.eJType.J30
                            popmax = 49
                            name = "J30"
                            pi = 1
                        Case clsPSPLIB.eJType.J60
                            popmax = 49
                            name = "J60"
                            pi = 0.2
                        Case clsPSPLIB.eJType.J90
                            popmax = 49
                            name = "J90"
                            pi = 0.5
                            'pi = 0.9
                        Case clsPSPLIB.eJType.J120
                            name = "J120"
                            popmax = 23
                            pi = 0.4
                    End Select
                Case 5000
                    Select Case type
                        Case clsPSPLIB.eJType.J30
                            popmax = 99
                            name = "J30"
                            pi = 0.8
                        Case clsPSPLIB.eJType.J60
                            popmax = 49
                            name = "J60"
                            pi = 0.7
                        Case clsPSPLIB.eJType.J90
                            popmax = 49
                            name = "J90"
                            pi = 0.9
                        Case clsPSPLIB.eJType.J120
                            name = "J120"
                            'popmax = 49
                            popmax = 49
                            'pi = 0.4
                            pi = 0.4
                    End Select
                Case 50000
                    Select Case type
                        Case clsPSPLIB.eJType.J30
                            If detectClones Then
                                popmax = 149
                            Else
                                popmax = 999
                            End If
                            name = "J30"
                            pi = 1
                        Case clsPSPLIB.eJType.J60
                            popmax = 299
                            name = "J60"
                            pi = 1
                        Case clsPSPLIB.eJType.J90
                            popmax = 299
                            name = "J90"
                            pi = 1 '0.9
                        Case clsPSPLIB.eJType.J120
                            name = "J120"
                            popmax = 399
                            pi = 0.4
                    End Select

                Case 10000
                    Select Case type
                        Case clsPSPLIB.eJType.J120
                            name = "J120"
                            popmax = 99
                            pi = 0.4
                    End Select
                Case 25000
                    Select Case type
                        Case clsPSPLIB.eJType.J120
                            name = "J120"
                            popmax = 199
                            pi = 0.4
                    End Select
                Case 100000
                    Select Case type
                        Case clsPSPLIB.eJType.J120
                            name = "J120"
                            popmax = 399
                            pi = 0.9
                    End Select
                Case Else
                    Throw New Exception(maxSched & " not supported")
            End Select
            Select Case name
                Case "J120"
                    vars = New Single()() {New Single() {1.5, 1.8, 2.1}, New Single() {0.25, 0.5, 0.75, 1}, New Single() {0.1, 0.2, 0.3, 0.4, 0.5}}
                Case "J30", "J60", "J90"
                    vars = New Single()() {New Single() {1.5, 1.8, 2.1}, New Single() {0.25, 0.5, 0.75, 1}, New Single() {0.2, 0.5, 0.7, 1}}
            End Select

            Return popmax
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function _ALtoSCH(ByVal al As HashSet(Of Int32), ByRef proj As clsProject, ByRef diagrams As Dictionary(Of String, Int32()()), ByRef res_hash As Dictionary(Of Int32, Int32())) As Int32
        Try
            Dim makespan As New clsMakeSpanWithRes
            'If Not hash.ContainsKey(acStr) Then
            Dim span = makespan.CalcMakeSpan(al, proj, diagrams, res_hash, clsMakeSpanWithRes.eDirection.Left, False)
            'sw.WriteLine(String.Concat(New IO.FileInfo(sFile).Name, ";", tsMPM.ToString.Replace(".", ","), ";", tempProj.MPMTime, ";", ProjectLength, ";",
            '                  ListToString(activityList) & ";", pops, ";", ts.ToString.Replace(".", ","), ";", span, ";", hashed))
            proj.Fitness = span
            proj.ActivtyList = GetAL(proj)


            ' proj.ActivtyList = al
            proj.PlanedTimes = PlanedToString(proj)

            If check Then
                Dim valid As Boolean = SuccessorValidation(proj)
                Dim resvalid As Boolean = ResourceValidation(proj)

                If Not (valid And resvalid) Then
                    Debug.Print("Invalid")
                End If
            End If

            If proj.TasksA.Last.PlanedAt < span Then
                Debug.Print("falsch")
            End If
            Return span
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function getParameter(ByVal var()() As Single, ByVal count As Int32, ByVal actInstance As Int32) As Single()
        Try
            Dim ret(2) As Single
            Dim ncarea As Int32 = count / var(0).Length
            Dim ncInstance As Int32 = 0
            Dim ncInstance2 As Int32 = 0
            For a As Int32 = 0 To var(0).Length - 1
                If actInstance > a * ncarea And actInstance <= (a + 1) * ncarea Then
                    ret(0) = var(0)(a)
                    ncInstance = (a * ncarea) + 1
                    ncInstance2 = a * ncarea
                    Exit For
                End If
            Next
            Dim rfarea As Int32 = ncarea / var(1).Length
            Dim rfInstance As Int32 = 0
            For a As Int32 = 0 To var(1).Length - 1
                If actInstance - (ncInstance2 - 1) > a * rfarea And actInstance - ncInstance2 <= (a + 1) * rfarea Then
                    ret(1) = var(1)(a)
                    rfInstance = a * (rfarea)
                    Exit For
                End If
            Next

            Dim rcarea As Int32 = (actInstance - ncInstance) - rfInstance

            ret(2) = var(2)(rcarea)
            'Debug.Print(actInstance & "-" & ret(0) & "-" & ret(1) & "-" & ret(2))
            Return ret
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function getInstanceCount(var()() As Single) As Int32
        Try
            Dim ret As Int32 = 1
            For a As Int32 = 0 To var.Count - 1
                ret *= var(a).Length
            Next
            Return ret
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function OptCheck(ByVal span As Int32, ByRef optspan As Int32, ByVal projInfo As clsProject) As Boolean
        Try
            If span < optspan Then
                'optAct = acStr
                ' topdiagrams = diagrams
                optspan = span
            End If
            If optspan = projInfo.MPMTime Then
                Return True
            End If
            Return False
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function _Calc(ByVal sFile As String, ByVal starttime As Date, ByVal type As clsPSPLIB.eJType, maxSched As Int32) As Double()
        Dim sw As IO.StreamWriter = Nothing
        Try
            If randomType = 2 Then
                If randConst Then
                    RandNum = New System.Random(randConstV)
                Else
                    RandNum = New System.Random()
                End If
            Else
                Randomize()
            End If
            '   tres = RandNum.Next(7500, 9000) / 10000
            Dim neighbourProjList As List(Of KeyValuePair(Of Single, clsProject))
            Dim cloneList As HashSet(Of Int32) = New HashSet(Of Int32)
            Dim bDocument As Boolean = False
            Dim sFolder As String = ""
            PrepareOutFolder(sFolder, starttime)
            Dim name As String = ""
            Dim bOpt As Boolean = False
            Dim opt30 As New clsJ30opt
            Dim vglOpt() As Single = Nothing

            ' res_hash = New Dictionary(Of Int32, Int32())
            Dim pi As Single = 1
            Dim var()() As Single = Nothing
            Dim popmax As Int32 = SetPopSize(type, name, pi, maxSched, var)
            sw = New IO.StreamWriter(sFolder & name & "_" & popmax & "_messure.txt", True)
            '    For y As Int32 = 1 To 10
            Dim nSched As Int32 = 0
            Dim res_hash As New Dictionary(Of Int32, Int32())
            Dim psp As New clsPSPLIB
            Dim projInfo As New clsProject
            Dim initFitness As Int32 = 0
            Dim initFintnessN As Int32 = 0
            projInfo.CriticalPath = New HashSet(Of String)
            ProjectLength = 0
            ProjectCalculated = False
            If bDocument Then
                projInfo.InputFile = New IO.FileInfo(sFile).Name
            End If
            Dim ds As task = psp.FileToDataSet(sFile, projInfo, type)
            Dim ht As Dictionary(Of Int32, clsTask) = New clsDataStruc().DataToObject(ds)

            'measure vars
            Dim tsGesamt As New TimeSpan
            Dim tsMPM As New TimeSpan
            Dim tsInit As New TimeSpan
            Dim tsGA As New TimeSpan
            Dim tsInitN As New TimeSpan
            Dim tsGAN As New TimeSpan
            Dim begin = Now
            'instance names
            Dim file As String = New IO.FileInfo(sFile).Name
            file = file.ToUpper.Replace(name, "")
            Dim ofile() As String = file.Split("_")
            Dim instance = ofile(0)
            Dim replication = ofile(1).Split(".")(0)
            Dim gesamtInstances As Int32 = getInstanceCount(var)
            'For i As Int32 = 1 To gesamtInstances
            '    getParameter(var, gesamtInstances, i)
            'Next
            Dim params() As Single = getParameter(var, gesamtInstances, instance)
            Dim NC As Single = params(0)
            Dim RF As Single = params(1)
            Dim RS As Single = params(2)
            If type = clsPSPLIB.eJType.J30 Then
                Dim row As Int32 = 0
                Do Until opt30.j30opt(row)(0) = instance And opt30.j30opt(row)(1) = replication
                    row += 1
                Loop
                vglOpt = opt30.j30opt(row)
            End If
            Dim mpm As New clsMPM
            mpm.AnaylseTasks(CloneDictionary(Of Int32, clsTask)(ht), ht, 0, projInfo)
            projInfo.TasksA = New List(Of clsTask)
            Dim a As Int32 = 1
            For Each task As clsTask In ht.Values
                With task
                    .MPMFAZ = .FAZ
                    .MPMFEZ = .FEZ
                    .MPMPuffer = .Puffer
                    .MPMSAZ = .SAZ
                    .MPMSEZ = .SEZ
                End With
                Dim r(task.RenewableResources.Keys.Count - 1) As Int32
                Dim i As Int32 = 0
                For Each res As String In task.RenewableResources.Keys
                    r(i) = task.RenewableResources(res)
                    i += 1
                Next
                If a = 1 Then 'twice
                    projInfo.TasksA.Add(task.Clone(False))
                End If
                res_hash.Add(task.Key, r)
                projInfo.TasksA.Add(task.Clone(False))
                a += 1
            Next
            tsMPM = Now - begin
            Dim beginInit As DateTime = Now
            'sw.WriteLine(New IO.FileInfo(sFile).Name & " - " & ts.ToString & " - " & ProjectLength & " MPM(" & projInfo.MPMTime & ") - " & Join(projInfo.CriticalPath.ToArray(), ","))
            Dim optspan As Int32 = 1000
            Dim optAct As String = ""
            begin = Now
            Dim hash As New Dictionary(Of String, Dictionary(Of String, Int32()()))
            Dim hashed As Long = 0
            Dim pops As Long = 0
            Dim projList As New List(Of KeyValuePair(Of Single, clsProject))
            Dim topdiagrams As Dictionary(Of String, Int32()()) = Nothing
            Dim initShedules As Int32 = 0
            'generate InitPopulation
            'STEP 1 & 2
            Dim regret As New clsRegretCalc
            'GetInitPopulation
            Do While pops <= popmax
                'Regret biased init schedule
                Dim tempProj As clsProject = projInfo.Clone

                Dim diagrams As New Dictionary(Of String, Int32()())
                Dim activityList As HashSet(Of Int32) = regret.CalcRegretBiasedRandomSampling_Hartmann(
                        projInfo, 1, 1, clsRegretCalc.ePrioRule.SEZ, Nothing,
                        planDirect, If(planDirect, res_hash, Nothing))
                'Dim acStr As String = ListToString(activityList)
                Dim span As Int32
                If planDirect Then
                    span = projInfo.Fitness
                    tempProj = projInfo
                Else
                    span = _ALtoSCH(activityList, tempProj, diagrams, res_hash)
                End If
                Dim orgspan As Int32 = span
                Dim bAdd As Boolean = True
                If detectClones Then
                    bAdd = IsClone(cloneList, activityList)
                End If
                If bAdd Then
                    projList.Add(New KeyValuePair(Of Single, clsProject)(span, tempProj))
                End If
                bOpt = OptCheck(span, optspan, projInfo)
                If bOpt Then Exit Do
                If countClones Then
                    pops += 1
                Else
                    If bAdd Then
                        pops += 1
                    End If
                End If

                If pops >= popmax Then
                    Exit Do
                End If
                Dim rspan As Int32
                Dim rightJList As New HashSet(Of Int32)
                Dim rightProj As clsProject = tempProj.Clone(False, True)
                Try
                    If justifyEx Then
                        rightProj.GenerationType = "RightJustifiedEx"
                        rightJList = regret.Justify_Valls_byEx(rightProj, clsRegretCalc.eJustifyDirection.Right, diagrams, res_hash)

                    Else
                        rightProj.GenerationType = "RightJustified"
                        rightJList = regret.Justify_Valls(rightProj, clsRegretCalc.eJustifyDirection.Right, diagrams, res_hash)
                    End If
                    span = rightProj.TasksA.Last.PlanedAt
                    rightProj.PeakSum = 1
                    rspan = span
                    bAdd = True
                    If detectClones Then
                        bAdd = IsClone(cloneList, rightJList)
                    End If
                    If bAdd Then projList.Add(New KeyValuePair(Of Single, clsProject)(span, rightProj))
                Catch ex As Exception
                    Debug.Print("Error INIT RIGHT: " & ex.ToString)
                End Try
                bOpt = OptCheck(span, optspan, projInfo)
                If bOpt Then Exit Do
                If countClones Then
                    pops += 1
                Else
                    If bAdd Then
                        pops += 1
                    End If
                End If
                If pops >= popmax Then
                    Exit Do
                End If
                bAdd = True
                Try
                    Dim leftJList As New HashSet(Of Int32)
                    Dim leftProj As New clsProject
                    If justifyLeftType = 1 Then
                        leftProj = projInfo.Clone
                        diagrams = New Dictionary(Of String, Int32()())
                        span = _ALtoSCH(rightJList, leftProj, diagrams, res_hash)
                    Else

                        leftProj = rightProj.Clone(False, True)
                        If justifyEx Then
                            leftProj.GenerationType = "LeftJustifiedEx"
                            leftJList = regret.Justify_Valls_byEx(leftProj, clsRegretCalc.eJustifyDirection.Left, diagrams, res_hash)
                        Else
                            leftProj.GenerationType = "LeftJustified"
                            leftJList = regret.Justify_Valls(leftProj, clsRegretCalc.eJustifyDirection.Left, diagrams, res_hash)
                        End If
                        leftProj.PeakSum = 1
                        span = leftProj.TasksA.Last.PlanedAt
                    End If
                    bAdd = True
                    If detectClones Then
                        bAdd = IsClone(cloneList, leftJList)
                    End If
                    If bAdd Then projList.Add(New KeyValuePair(Of Single, clsProject)(span, leftProj))
                Catch ex As Exception
                    Debug.Print("Error INIT LEFT: " & ex.ToString)
                End Try
                If orgspan < rspan Or rspan < span Then
                    'righ sh besser al org
                    Throw New Exception("DJ Error")
                End If
                bOpt = OptCheck(span, optspan, projInfo)
                If bOpt Then Exit Do

                ' Debug.Print(ListToString(activityList))
                'Debug.Print(ListToString(leftJList))
                'Debug.Print(ListToString(rightJList))

                If countClones Then
                    pops += 1
                Else
                    If bAdd Then
                        pops += 1
                    End If
                End If
                initShedules += 3 'count all schedules, regardless if part of population (clones!)
            Loop
            If countClones Then
                nSched += initShedules
            Else
                nSched = pops
            End If
            '
            ' Crossover
            projList.Sort(AddressOf Compare1)
            ' Dim x = From o In projList
            '            Order By o.Key Ascending, o.Value.GenerationType Ascending
            'Dim templ As New List(Of KeyValuePair(Of Int32, clsProject))
            'For Each xx In x
            '    templ.Add(xx)
            'Next
            'projList = templ
            'projList = CType(x, List(Of KeyValuePair(Of Int32, clsProject))).ToList

            ' Exit Function


            initFitness = projList.First().Value.Fitness
            If initFitness = projInfo.MPMTime Then
                'opt zeit bereits erreicht
                bOpt = True
            End If
            Dim beginGA As DateTime = Now
            tsInit = Now - beginInit

            Dim nIter = 0
            Dim cnt As Int32 = maxSched
            If Not IsHGA11 Then
                cnt = maxSched / 2
            Else
                pi = 1
            End If
            If Not bOpt Then
                Do While nSched <= (cnt)
                    'Do While nSched <= (maxSched / 2)
                    Dim parentSel As New clsParentSelector
                    Dim newProjList As Dictionary(Of Int32, clsProjectPair) = parentSel.GeneratePairs(pi, projList, popmax)
                    Dim cross As New clsPeakCrossover
                    Dim nbefore As Int32 = 0
                    Dim nAfter As Int32 = 0
                    If Not countClones Then
                        nbefore = projList.Count
                    End If
                    projList = cross.Crossover(projList, newProjList, 0.75, 0.9, res_hash, cloneList)
                    projList.Sort(AddressOf Compare1)
                    If Not countClones Then
                        nAfter = projList.Count
                    End If
                    ' Dim x = From o In projList Order By o.Key Ascending ', o.Value.PeakSum Descending
                    'Dim templ = New List(Of KeyValuePair(Of Int32, clsProject))
                    'Dim xc As Int32 = 0
                    'For Each xx In x
                    '    templ.Add(xx)
                    '    If xc = popmax Then
                    '        Exit For
                    '    End If
                    '    xc += 1
                    'Next
                    'projList = templ
                    Dim popCOunt = projList.Count - 1
                    If countClones Then
                        nSched += newProjList.Count * 6
                    Else
                        nSched += (nAfter - nbefore)
                    End If
                    If diversityControl Then
                        Dim factor As Single = 1 - (popmax / popCOunt)
                        Dim biasedList As New List(Of KeyValuePair(Of Single, clsProject))
                        For Each pr As KeyValuePair(Of Single, clsProject) In projList
                            pr.Value.BiasedFitness = pr.Value.Fitness + (factor * pr.Value.MaxDistance)
                            biasedList.Add(New KeyValuePair(Of Single, clsProject)(pr.Value.BiasedFitness, pr.Value))
                        Next
                        biasedList.Sort(AddressOf Compare1)
                        projList = biasedList
                    End If

                    Do While popCOunt > popmax
                        Dim sel = popCOunt
                        If selectBadOnes Then
                            sel = parentSel.Zufallszahl(popmax / 3, popCOunt)
                        End If
                        Dim tempPr As KeyValuePair(Of Single, clsProject) = projList.ElementAt(sel)
                        Dim templ As HashSet(Of Int32) = tempPr.Value.ActivtyList
                        UpdateCloneList(cloneList, templ)
                        projList.RemoveAt(sel)
                        popCOunt = projList.Count - 1
                    Loop
                    If nSched >= (cnt) Then
                        Exit Do
                    End If
                Loop
            End If
            If IsHGA11 Then
                bOpt = True
            End If
            ' djga

            Dim beginnN As DateTime = Now
            tsGA = Now - beginGA

            pops = 0
            cloneList = New HashSet(Of Int32)
            neighbourProjList = New List(Of KeyValuePair(Of Single, clsProject))
            neighbourProjList.Add(New KeyValuePair(Of Single, clsProject)(projList.First().Value.Fitness, projList.First().Value))
            If projList.First().Value.Fitness = projInfo.MPMTime Then
                '    neighbourProjList.Add(New KeyValuePair(Of Int32, clsProject)(projList.First().Value.Fitness, projList.First().Value))
                bOpt = True
            End If
            Dim y As Int32 = 0
            initShedules = 0
            If Not bOpt Then
                Do While pops <= popmax / 2
                    Dim badd As Boolean = True
                    Dim neighbourProj As clsProject = projList.First().Value.Clone()
                    'Dim neighbourProj As clsProject = projList(y).Value.Clone()
                    Dim diagrams As New Dictionary(Of String, Int32()())
                    Dim neighbourList As HashSet(Of Int32) = regret.CalcRegretBiasedRandomSampling_Hartmann(neighbourProj, 1, 1, clsRegretCalc.ePrioRule.SEZ, neighbourProj.ActivtyList)
                    Dim span As Int32 = _ALtoSCH(neighbourList, neighbourProj, diagrams, res_hash)
                    neighbourProj.GenerationType = "NeighbourInit"
                    If neighbourProj.Fitness <> span Then
                        Throw New Exception("incorrect")
                    End If
                    If span < optspan Then
                        optspan = span
                    End If
                    If optspan = projInfo.MPMTime Then
                        Exit Do
                    End If
                    badd = True
                    If detectClones Then
                        badd = IsClone(cloneList, neighbourList)
                    End If
                    If countClones Then
                        pops += 1
                    Else
                        If badd Then
                            pops += 1
                        End If
                    End If
                    If pops >= popmax / 2 Then
                        Exit Do
                    End If
                    If badd Then neighbourProjList.Add(New KeyValuePair(Of Single, clsProject)(span, neighbourProj))
                    Dim rightProj As clsProject = neighbourProj.Clone(False, True)
                    Dim rightJList As New HashSet(Of Int32)
                    Try
                        If justifyEx Then
                            rightProj.GenerationType = "NeighbourRightJustifiedEx"
                            rightJList = regret.Justify_Valls_byEx(rightProj, clsRegretCalc.eJustifyDirection.Right, diagrams, res_hash)
                        Else
                            rightProj.GenerationType = "NeighbourRightJustified"
                            rightJList = regret.Justify_Valls(rightProj, clsRegretCalc.eJustifyDirection.Right, diagrams, res_hash)
                        End If
                        span = rightProj.TasksA.Last.PlanedAt
                        If rightProj.Fitness <> span Then
                            Throw New Exception("incorrect")
                        End If
                        rightProj.PeakSum = 1
                        badd = True
                        If detectClones Then
                            badd = IsClone(cloneList, rightJList)
                        End If
                        If badd Then neighbourProjList.Add(New KeyValuePair(Of Single, clsProject)(span, rightProj))
                    Catch ex As Exception
                        Debug.Print("Error Neigbour RIGHT: " & ex.ToString)
                    End Try
                    If countClones Then
                        pops += 1
                    Else
                        If badd Then
                            pops += 1
                        End If
                    End If
                    If pops >= popmax / 2 Then
                        Exit Do
                    End If
                    bOpt = OptCheck(span, optspan, projInfo)
                    If bOpt Then Exit Do
                    Try
                        Dim leftProj As New clsProject
                        Dim leftJList As New HashSet(Of Int32)
                        If justifyLeftType = 1 Then
                            leftProj = projInfo.Clone
                            diagrams = New Dictionary(Of String, Int32()())
                            span = _ALtoSCH(rightJList, leftProj, diagrams, res_hash)
                        Else
                            leftProj = rightProj.Clone(False, True)
                            If justifyEx Then
                                leftProj.GenerationType = "NeighbourLeftJustifiedEx"
                                leftJList = regret.Justify_Valls_byEx(leftProj, clsRegretCalc.eJustifyDirection.Left, diagrams, res_hash)
                            Else
                                leftProj.GenerationType = "NeighbourLeftJustified"
                                leftJList = regret.Justify_Valls(leftProj, clsRegretCalc.eJustifyDirection.Left, diagrams, res_hash)
                            End If
                            span = leftProj.TasksA.Last.PlanedAt
                        End If
                        If leftProj.Fitness <> span Then
                            Throw New Exception("incorrect")
                        End If
                        leftProj.PeakSum = 1
                        badd = True
                        If detectClones Then
                            badd = IsClone(cloneList, leftJList)
                        End If
                        If badd Then neighbourProjList.Add(New KeyValuePair(Of Single, clsProject)(span, leftProj))
                        'neighbourProj = leftProj.Clone()
                    Catch ex As Exception
                        Debug.Print("Error Neigbour LEFT: " & ex.ToString)
                    End Try

                    bOpt = OptCheck(span, optspan, projInfo)
                    If bOpt Then Exit Do
                    If countClones Then
                        pops += 1
                    Else
                        If badd Then
                            pops += 1
                        End If
                    End If
                    If pops >= popmax / 2 Then
                        Exit Do
                    End If
                    y += 1
                    initShedules += 3
                Loop
            End If
            neighbourProjList.Sort(AddressOf Compare1)
            initFintnessN = neighbourProjList.First().Value.Fitness
            Dim beginGAN As DateTime = Now
            tsInitN = Now - beginnN
            If countClones Then
                nSched += initShedules
            Else
                nSched += pops
            End If
            '

            If Not bOpt Then
                Do While nSched <= (maxSched)
                    Dim parentSel As New clsParentSelector
                    Dim newProjList As Dictionary(Of Int32, clsProjectPair) = parentSel.GeneratePairs(pi, neighbourProjList, popmax / 2)
                    'Dim newProjList As Dictionary(Of Int32, clsProjectPair) = parentSel.GeneratePairs(pi, neighbourProjList, popmax)
                    Dim cross As New clsPeakCrossover
                    Dim nbefore As Int32 = 0
                    Dim nAfter As Int32 = 0
                    If Not countClones Then
                        nbefore = neighbourProjList.Count
                    End If
                    neighbourProjList = cross.Crossover(neighbourProjList, newProjList, 0.75, 0.9, res_hash, cloneList)
                    neighbourProjList.Sort(AddressOf Compare1)
                    If Not countClones Then
                        nAfter = neighbourProjList.Count
                    End If
                    'Dim x = From o In neighbourProjList Order By o.Key Ascending ', o.Value.PeakSum Descending
                    'Dim templ = New List(Of KeyValuePair(Of Int32, clsProject))
                    'Dim xc As Int32 = 0
                    'For Each xx In x
                    '    templ.Add(xx)
                    '    If xc = popmax / 2 Then
                    '        Exit For
                    '    End If
                    '    xc += 1
                    'Next
                    'neighbourProjList = templ
                    If neighbourProjList.First.Value.Fitness = projInfo.MPMTime Then
                        bOpt = True
                        Exit Do
                    End If
                    Dim popCOunt = neighbourProjList.Count - 1
                    If countClones Then
                        nSched += newProjList.Count * 6
                    Else
                        nSched += (nAfter - nbefore)
                    End If
                    If diversityControl Then
                        Dim factor As Single = 1 - ((popmax / 2) / popCOunt)
                        Dim biasedList As New List(Of KeyValuePair(Of Single, clsProject))
                        For Each pr As KeyValuePair(Of Single, clsProject) In neighbourProjList
                            pr.Value.BiasedFitness = pr.Value.Fitness + (factor * pr.Value.MaxDistance)
                            biasedList.Add(New KeyValuePair(Of Single, clsProject)(pr.Value.BiasedFitness, pr.Value))
                        Next
                        biasedList.Sort(AddressOf Compare1)
                        neighbourProjList = biasedList
                    End If
                    Do While popCOunt > popmax / 2
                        Dim sel = popCOunt
                        If selectBadOnes Then
                            sel = parentSel.Zufallszahl(popmax / 6, popCOunt)
                        End If
                        Dim tempPr As KeyValuePair(Of Single, clsProject) = neighbourProjList.ElementAt(sel)
                        Dim templ As HashSet(Of Int32) = tempPr.Value.ActivtyList
                        UpdateCloneList(cloneList, templ)
                        neighbourProjList.RemoveAt(sel)
                        popCOunt = neighbourProjList.Count - 1
                    Loop
                    If nSched >= maxSched Then
                        Exit Do
                    End If
                Loop
            End If

            tsGAN = Now - beginGAN
            tsGesamt = Now - begin
            Debug.Print(neighbourProjList.First().Value.Peaks & ";" & initFitness & ";" & projList.First().Value.Fitness & ";" & initFintnessN & ";" & neighbourProjList.First().Value.Fitness & ";" & bOpt & ";" & tsGesamt.ToString & ";" & neighbourProjList.First().Value.GenerationType)
            Dim vgl As Int32 = 0
            Dim valid As Boolean = True
            Dim resValid As Boolean = True
            resValid = ResourceValidation(neighbourProjList(0).Value)
            valid = SuccessorValidation(neighbourProjList(0).Value)

            If document Then

                If Not vglOpt Is Nothing Then
                    vgl = vglOpt(2)
                    If neighbourProjList.First().Value.Fitness < vgl Then
                        'superoptimal
                        Dim tm = Now.ToString("yyyyMMdd_HHmmss")
                        clsDiagrammCreator.WriteOptFile(sFolder & New IO.FileInfo(sFile).Name & "_opt_" & tm & ".txt", neighbourProjList.First().Value)
                        clsDiagrammCreator.WriteFile(sFolder & New IO.FileInfo(sFile).Name & "_makespan_" & tm & ".htm", neighbourProjList(0).Value.Diagramm,
                                                   CType(neighbourProjList(0).Value, clsProject))
                    End If
                End If
            End If

            If Not vglOpt Is Nothing Then
                vgl = vglOpt(2)
            End If
            sw.WriteLine(String.Concat(instance, ";",
                                       replication, ";",
                                       NC, ";",
                                       RF, ";",
                                       RS, ";",
                                       projInfo.MPMTime, ";",
                                       vgl, ";",
                                       ProjectLength, ";",
                                       Join(projInfo.CriticalPath.ToArray(), "|"), ";",
                                       pops, ";",
                                       tsGesamt.ToString.Replace(".", ","), ";",
                                       tsMPM.ToString.Replace(".", ","), ";",
                                       tsInit.ToString.Replace(".", ","), ";",
                                       tsGA.ToString.Replace(".", ","), ";",
                                       tsInitN.ToString.Replace(".", ","), ";",
                                       tsGAN.ToString.Replace(".", ","), ";",
                                       neighbourProjList.First().Value.Fitness, ";",
                                       initFintnessN, ";",
                                       projList.First().Value.Fitness, ";",
                                       initFitness, ";",
                                       100 * (neighbourProjList.First().Value.Fitness - projInfo.MPMTime) / projInfo.MPMTime,
                                       ";", vgl, ";;", valid, ";", resValid, ";", PlanedToString(neighbourProjList.First().Value)))

            'sw.WriteLine(New IO.FileInfo(sFile).Name & " - " & pops & " - " & ts.ToString & " -  MakeSpanCalcAll(" & optspan & "," & projInfo.MPMTime & "), hashed: " & hashed)



            'calc if feasible with res constraints
            'begin = Now
            'Dim rcpsp As New clsRCPSP_simple
            'rcpsp.CheckTimeLine(projInfo)
            'ts = New TimeSpan
            'ts = Now - begin
            '  Next

            If bDocument Then

                ' Dim keys As keylistpair() = projList.ToArray()
                ' Array.Sort(keys)




                Dim bZusatz As Boolean = False
                If bZusatz Then 'momentan ganz deaktivieren!
                    'Dim diagram(topdiagrams.Keys.Count - 1)()() As Int32
                    'Dim x As Int32 = 0
                    'For Each key As String In topdiagrams.Keys
                    '    diagram(x) = topdiagrams(key)
                    '    x += 1
                    'Next
                    sw.Close()
                    clsDiagrammCreator.WriteFile(sFolder & New IO.FileInfo(sFile).Name & "_makespan.htm", neighbourProjList(0).Value.Diagramm,
                                                 CType(neighbourProjList(0).Value, clsProject))
                End If
            End If
            Dim vglV As Double = 0
            If vgl > 0 Then
                vglV = 100 * (neighbourProjList.First().Value.Fitness - vgl) / vgl
            End If
            Return New Double() {100 * (neighbourProjList.First().Value.Fitness - projInfo.MPMTime) / projInfo.MPMTime, tsGesamt.TotalMilliseconds, vglV}
        Catch ex As Exception
            sw.WriteLine(New IO.FileInfo(sFile).Name & ";" & ex.Message)
            Throw New Exception(ex.ToString)
        Finally
            If Not sw Is Nothing Then
                sw.Close()
            End If
        End Try
    End Function

    Private Function Compare1(ByVal a As KeyValuePair(Of Single, clsProject), ByVal b As KeyValuePair(Of Single, clsProject)) As Int32
        Try
            Return a.Key.CompareTo(b.Key)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function CalcJ30Single(ByVal maxSchedule As Int32) As Boolean
        Try
            Dim sInputFile As String = "j1206_6.sm"
            'Dim sInputFile As String = "j3013_8.sm"
            Dim sInputPath As String = My.Application.Info.DirectoryPath & "\INPUT\J120.sm\" & sInputFile
            ' Dim sInputPath As String = My.Application.Info.DirectoryPath & "\INPUT\J30\" & sInputFile
            _Calc(sInputPath, Now, clsPSPLIB.eJType.J120, maxSchedule)
            '_Calc(sInputPath, Now, clsPSPLIB.eJType.J30, maxSchedule)
            Return True
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function _CalcAll_Parallel(ByVal maxSchedule As Int32, ByVal type As clsPSPLIB.eJType, Optional ByVal sample As Boolean = False) As Double()
        Try
            Dim myavg As Double = 0
            Dim tm As Double = 0
            Dim opt As Double = 0
            Dim maths As New Maths
            Dim begin As Date = Now
            Dim subf As String = ""
            Select Case type
                Case clsPSPLIB.eJType.J120
                    subf = "J120.sm"
                Case clsPSPLIB.eJType.J30
                    subf = "J30"
                Case clsPSPLIB.eJType.J60
                    subf = "J60.sm"
                Case clsPSPLIB.eJType.J90
                    subf = "J90.sm"
            End Select
            Dim sInputPaths() As String = IO.Directory.GetFiles(My.Application.Info.DirectoryPath & "\INPUT\" & subf & "\", "*" & If(sample, "_1", "") & ".sm")
            Dim i As Int32 = 0
            Dim count As Int32 = sInputPaths.Length
            Dim arr(count - 1) As Double
            Console.Write(subf.Replace("*.sm", "") & "-" & maxSchedule & ": init ...")
            'Parallel.ForEach(sInputPaths, Sub(inputs)
            '                                  Try
            '                                      Dim ret() = _Calc(inputs, begin, type, maxSchedule)
            '                                      tm += ret(1)
            '                                      arr(i) = ret(0)
            '                                      myavg += arr(i)
            '                                      opt += ret(2)
            '                                      i += 1
            '                                      Console.SetCursorPosition(0, Console.CursorTop)
            '                                      Console.Write(subf.Replace("*.sm", "") & "-" & maxSchedule & ":" & i & "|" & count & "                                        ")
            '                                  Catch ex As Exception
            '                                      Debug.Print(New IO.FileInfo(inputs).Name & " - " & ex.ToString)
            '                                  End Try

            '                              End Sub)
            'For Each sInputPath In sInputPaths
            '    Try
            '        Dim ret() = _Calc(sInputPath, begin, type, maxSchedule)
            '        tm += ret(1)
            '        arr(i) = ret(0)
            '        myavg += arr(i)
            '        opt += ret(2)

            '        i += 1
            '        Console.SetCursorPosition(0, Console.CursorTop)
            '        Console.Write(subf.Replace("*.sm", "") & "-" & maxSchedule & ":" & i & "|" & count & "                                        ")
            '    Catch ex2 As Exception
            '        Debug.Print(New IO.FileInfo(sInputPath).Name & " - " & ex2.ToString)
            '    End Try
            'Next
            Dim stdDev = maths.StandardDeviation(arr)
            Return New Double() {(myavg / (i)), stdDev, tm / i, opt / i}
        Catch ex As Exception
            Throw
        End Try
    End Function
    Private Function _CalcAll(ByVal maxSchedule As Int32, ByVal type As clsPSPLIB.eJType,
                              Optional ByVal sample As Boolean = False,
                              Optional ByVal startat As Int32 = 0) As Double()
        Try
            Dim myavg As Double = 0
            Dim tm As Double = 0
            Dim opt As Double = 0
            Dim maths As New Maths
            Dim begin As Date = Now
            Dim subf As String = ""
            Select Case type
                Case clsPSPLIB.eJType.J120
                    subf = "J120.sm"
                Case clsPSPLIB.eJType.J30
                    subf = "J30"
                Case clsPSPLIB.eJType.J60
                    subf = "J60.sm"
                Case clsPSPLIB.eJType.J90
                    subf = "J90.sm"
            End Select
            Dim sInputPaths() As String = IO.Directory.GetFiles(My.Application.Info.DirectoryPath & "\INPUT\" & subf & "\", "*" & If(sample, "_1", "") & ".sm")
            Dim i As Int32 = 0
            Dim count As Int32 = sInputPaths.Length
            Dim arr(count - 1) As Double
            Console.Write(subf.Replace("*.sm", "") & "-" & maxSchedule & ": init ...")
            For Each sInputPath In sInputPaths
                Try
                    If i >= startat Then
                        Dim ret() = _Calc(sInputPath, begin, type, maxSchedule)
                        tm += ret(1)
                        arr(i) = ret(0)
                        myavg += arr(i)
                        opt += ret(2)
                    End If
                    i += 1
                    Console.SetCursorPosition(0, Console.CursorTop)
                    Dim ts As TimeSpan = New TimeSpan(0, 0, 0, 0, Math.Round((tm / i) * (count - i), 0))
                    Console.Write(subf.Replace("*.sm", "") & "-" & maxSchedule & ":" & i & "|" & count & " | " & ts.ToString & "                                     ")

                Catch ex2 As Exception
                    Console.Write(Environment.NewLine)
                    Console.ForegroundColor = ConsoleColor.Red
                    Console.WriteLine(New IO.FileInfo(sInputPath).Name & " - " & ex2.Message)
                    Console.ForegroundColor = ConsoleColor.Gray
                    Console.Write(Environment.NewLine)
                End Try
            Next
            Dim stdDev = maths.StandardDeviation(arr)
            Return New Double() {(myavg / (i)), stdDev, tm / i, opt / i, CDbl(begin.ToString("yyyyMMdd.HHmmss"))}
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function Calc30All_Parallel(ByVal maxSchedule As Int32) As Double()
        Try
            Return _CalcAll_Parallel(maxSchedule, clsPSPLIB.eJType.J30)
        Catch ex As Exception
            Throw
        End Try
    End Function


    Public Function CalcJ30All(ByVal maxSchedule As Int32, Optional ByVal sample As Boolean = False) As Double()
        Try
            Return _CalcAll(maxSchedule, clsPSPLIB.eJType.J30, sample)
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function CalcJ60All(ByVal maxSchedule As Int32, Optional ByVal sample As Boolean = False) As Double()
        Try
            Return _CalcAll(maxSchedule, clsPSPLIB.eJType.J60, sample)

            'Dim begin As Date = Now
            'Dim sInputPaths() As String = IO.Directory.GetFiles(My.Application.Info.DirectoryPath & "\INPUT\J60.sm\", "*.sm")
            'Dim i As Int32 = 1
            'Dim count As Int32 = sInputPaths.Length
            'For Each sInputPath In sInputPaths
            '    Try
            '        RaiseEvent Progress(i, count)
            '        _Calc(sInputPath, begin, clsPSPLIB.eJType.J60, maxSchedule)
            '        i += 1
            '    Catch ex2 As Exception
            '        Debug.Print(New IO.FileInfo(sInputPath).Name & " - " & ex2.ToString)
            '    End Try
            'Next
            'Return True
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function CalcJ90All(ByVal maxSchedule As Int32, Optional ByVal sample As Boolean = False) As Double()
        Try
            Return _CalcAll(maxSchedule, clsPSPLIB.eJType.J90, sample)
            'Dim begin As Date = Now
            'Dim sInputPaths() As String = IO.Directory.GetFiles(My.Application.Info.DirectoryPath & "\INPUT\J90.sm\", "*.sm")
            'Dim i As Int32 = 1
            'Dim count As Int32 = sInputPaths.Length
            'For Each sInputPath In sInputPaths
            '    Try
            '        RaiseEvent Progress(i, count)
            '        _Calc(sInputPath, begin, clsPSPLIB.eJType.J90, maxSchedule)
            '        i += 1
            '    Catch ex2 As Exception
            '        Debug.Print(New IO.FileInfo(sInputPath).Name & " - " & ex2.ToString)
            '    End Try
            'Next
            'Return True
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function CalcJ120All(ByVal maxSchedule As Int32, Optional ByVal sample As Boolean = False,
                                Optional ByVal startat As Int32 = 0) As Double()
        Try
            Return _CalcAll(maxSchedule, clsPSPLIB.eJType.J120, sample, startat)
            'Dim begin As Date = Now
            'Dim sInputPaths() As String = IO.Directory.GetFiles(My.Application.Info.DirectoryPath & "\INPUT\J120.sm\", "*.sm")
            'Dim i As Int32 = 1
            'Dim count As Int32 = sInputPaths.Length
            'For Each sInputPath In sInputPaths
            '    Try
            '        RaiseEvent Progress(i, count)
            '        _Calc(sInputPath, begin, clsPSPLIB.eJType.J120, maxSchedule)
            '        i += 1
            '    Catch ex2 As Exception
            '        Debug.Print(New IO.FileInfo(sInputPath).Name & " - " & ex2.ToString)
            '    End Try
            'Next
            'Return True
        Catch ex As Exception
            Throw
        End Try
    End Function
    Public Function CalcDemoTask() As Boolean
        Try
            Dim begin = Now
            Dim projInfo As New clsProject
            Dim ht As Dictionary(Of Int32, clsTask) = New clsDataStruc().DataToObject(_InitDemoData)
            Dim mpm As New clsMPM
            mpm.AnaylseTasks(New Dictionary(Of Int32, clsTask)(ht), ht, "", projInfo)
            Dim ts As New TimeSpan
            ts = Now - begin
            Debug.Print(ts.ToString & " - " & Join(projInfo.CriticalPath.ToArray(), ","))
            Return True
        Catch ex As Exception
            Throw
        End Try
    End Function

#Region "Private"
    Private Function _InitDemoData() As DataSet
        Try
            Dim cds As New clsDataStruc
            Dim ds As DataSet = cds.CreateDataSet
            cds.FillDemoData(ds.Tables("raw"))
            Return ds
        Catch ex As Exception
            Throw
        End Try
    End Function
#End Region

#End Region



End Class
